(FILECREATED "10-APR-76 20:56:44" <LENAT>U.;2 2508   

     changes to:  UCOMS FIXEDCONS

     previous date: " 8-APR-76 14:30:49" <LENAT>U.;1)


  (LISPXPRINT (QUOTE UCOMS)
	      T T)
  (RPAQQ UCOMS ((FNS CHANGE-B CLEAN1 CLEAN1ALL KILLB)
	  FIXEDCONS))
(DEFINEQ

(CHANGE-B
  [LAMBDA (B P CP)
    [COND
      ((OR (FMEMB B FACETS)
	   (FMEMB B AUX-FACETS))
	(SETQ P B)
	(PRINT (SETQ B STICKY-B)))
      [(GETHASH B HCON)
	(OR (FMEMB P FACETS)
	    (FMEMB P AUX-FACETS)
	    (PRINT (SETQ P STICKY-P]
      (B (TERPRI)
	 (PRIN1 "***** CANT UNDERSTAND THIS *****")
	 (HELP))
      (T (PRINT (SETQ B STICKY-B))
	 (PRINT (SETQ P STICKY-P]
    (SETQ STICKY-B B)
    (SETQ STICKY-P P)
    (OR (GETB B P)
	(PUT B P))                                                              (* Notice the use of "PUT" in this fn)
    (COND
      ((ERRORSET (LIST (QUOTE EDITP)
		       B
		       (QUOTE F)
		       P
		       (QUOTE P)
		       (QUOTE TTY:)))
	(DEFB B)
	(TERPRI)
	(PRIN1 B)
	(PRIN1 COMMA)
	(PRINT P)
	(CPRIN1 0 CRLF (LENGTH (SETQ FIXEDCONS (UNION (LIST B)
						      FIXEDCONS)))
		" fixed con's" DCR))
      (T (CPRIN1 0 CRLF " Aborting safely" DCR)
	 (LIST B P])

(CLEAN1
  [LAMBDA (B P1 P2)
    (MAPC (GETB B P1)
	  (FUNCTION (LAMBDA (Z)
	      (AND (IS-CON Z)
		   (INCRB Z P2 B])

(CLEAN1ALL
  [LAMBDA (B)
    (CLEAN1 B (QUOTE EXS)
	    (QUOTE UP))
    (CLEAN1 B (QUOTE UP)
	    (QUOTE EXS))
    (CLEAN1 B (QUOTE GENL)
	    (QUOTE SPEC))
    (CLEAN1 B (QUOTE SPEC)
	    (QUOTE GENL])

(KILLB
  [LAMBDA (B)
    [MAPC (GETB B (QUOTE GENL))
	  (FUNCTION (LAMBDA (S)
	      (DECRB S (QUOTE SPEC)
		     B]
    [MAPC (GETB B (QUOTE EXS))
	  (FUNCTION (LAMBDA (S)
	      (DECRB S (QUOTE UP)
		     B]
    [MAPC (GETB B (QUOTE UP))
	  (FUNCTION (LAMBDA (S)
	      (DECRB S (QUOTE EXS)
		     B]
    [MAPC (GETB B (QUOTE SPEC))
	  (FUNCTION (LAMBDA (S)
	      (DECRB S (QUOTE GENL)
		     B]
    (PUTD B NIL)
    (PUTHASH B NIL HCON)
    (DREMOVE B GINTPREDS)                                                       (* Be sure to remove this if a smarter 
										"interesting predicate list" scheme is 
										devised)
    (DREMOVE B CONCEPTS)
    (DREMOVE B FIXEDCONS)                                                       (* Really, we should follow up links 
										like GENL from B, and destroy all 
										mention of it anywhere)
    (RPLACD B NIL])
)
  (RPAQQ FIXEDCONS NIL)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (266 2459 (CHANGE-B 278 . 1212) (CLEAN1 1216 . 1339) (CLEAN1ALL 1343 . 1554) (KILLB 1558 . 2456)))))
STOP